# CVS: $Id: OPTIONS.pm,v 1.1 2007/10/08 09:26:03 schweitz Exp $
# Time-stamp: <27 Apr 00 18:34:15 giron1> 

=head1 NAME

OPTIONS - Options package with auto-loadable names

=head1 SYNOPSIS

 use OPTIONS;

 $OptList = new OPTIONS;

 $OptList->name(key1 => val1, key2 => val2, ...);
 $OptList->define($pOpt,'key1',$val1,'This is a nice option');

 my $OptListCopy = new OPTIONS;
 $OptListCopy->copy($OptList);

 $OptList->GetOpt
 $OptList->Display;
 $OptList->Usage($string,$help);
 $OptList->LocationRead;
 $OptList->LocationWrite($CORPUS);
 $OptList->ChannelRead;
 $OptList->SpeakersRead;

=head1 DESCRIPTION

This package defines some auto-loadable options names with
possibilities of associating a hash with each name. Some functions
related to frequently used options are also defined here.

=head1 EXAMPLES 

An example of auto-loaded option named I<list> with two hash
keys I<filename> and I<usage>:

 $myoptions = new OPTIONS;
 $myoptions->list( filename => 'mynicelist.txt', usage => "<name>\t: name of list\n");

You can then access each element with commands like:

 $myoptions->{list}{filename} = 'foo.txt';
 print $myoptions->{list}{usage};

=head1 SEE ALSO

L<makedblists>,
L<ent2esps>,
L<speech2sphere>

=head1 AUTHOR

 $Id: OPTIONS.pm,v 1.1 2007/10/08 09:26:03 schweitz Exp $
 Franck Giron

=head1 LOG

 $Log: OPTIONS.pm,v $
 Revision 1.1  2007/10/08 09:26:03  schweitz
 version 2.4, lib vergessen

 Revision 1.7  2000/04/27 16:36:01  giron1
 Pod documentation updated


=cut

package OPTIONS;

use FileHandle;
use Getopt::Long;

#----------------------------------------------------------------------

=head1 FUNCTIONS

Here are the different available functions

=cut

# Autoload the methods when not defined

sub AUTOLOAD{
  my $opt = shift;
  my $type = ref($opt) || $opt;
  my $name = $AUTOLOAD;

  $name =~ s/.*://;
  if (@_) {
    %params = @_;
    while ( ($k,$v) = each %params) {
      $opt->{$name}{$k} = $v;
    }
  }
}

#----------------------------------------------------------------------

=head2 new - Options constructor

=cut

sub new{
  my $opt = shift;
  my $class = ref($opt) || $opt;
  my $self = {};
  bless $self, $class;
  return $self;
}

#----------------------------------------------------------------------

=head2 copy - Options copy method

copies all keys and values to another list

=cut

sub copy{
  my $opt = shift;
  my $popt = shift;

  my $k;
  foreach $k (keys %$popt) {
    foreach (keys %{$popt->{$k}}) {
      $opt->{$k}{$_} = $popt->{$k}{$_};
    }
  }
}

#----------------------------------------------------------------------

=head2 define - Options definition method

this method defines the default value of a key and its usage depending
on the previous value of the option

=cut

sub define{
  my $opt = shift;
  my ($popt,$key,$val,$use) = @_;

  if ( defined($popt->{$key}{string}) ) {
    if ($opt->{$key}{string} ne $popt->{$key}{string}) {
      $val = $opt->{$key}{string};
    }
  }
  # Autoload the $key method
  $opt->$key(string => $val, Usage =>  $use );
}

#----------------------------------------------------------------------

=head2 getopt - Parsing method

It divides the command line arguments in those expecting something
(options) and the others without anything (commands) and stores them
in the I<$OptList> variable.

=cut

sub GetOpt{
  my $optlist = shift;

  my %options = ();
  my $key;

  my $debug = 0;

  foreach (sort keys %$optlist) {
    #$debug && warn "$_:", join(',',keys %{$optlist->{$_}}), "\n";
    # look for options (with arguments read as string with key: s)
    if (exists $optlist->{$_}{string} ) {
      $key = $_ . '=s';
      $debug && warn "$_:$optlist->{$_}{string}\n";
      $options{$key} = \$optlist->{$_}{string};
    }
    #look for commands (key: Do something)
    elsif (exists $optlist->{$_}{Do} ) {
      $key = $_;
      $options{$key} = \$optlist->{$_}{Do};
    }
  }
  return GetOptions(%options);
}

#----------------------------------------------------------------------

=head2 Display - Display method

Shows all the options and commands of a program.

=cut

sub Display{
  my $optlist = shift;

  my $use;
  # Display commands
  $use = "commands:\n";
  warn $use;
  foreach (sort keys %{$optlist}) {
    $use = "-$_\t: ";
    if (exists $optlist->{$_}{Do}) {
      $use .= "$optlist->{$_}{Usage}\n";
      warn $use;
    }
  }
  # Display options
  $use = "options:\n";
  warn $use;
  foreach (sort keys %{$optlist}) {
    $use = "-$_ ";
    if (exists $optlist->{$_}{string}) {
      if (m/^e/) {
	$use .= "<ext>\t: ". $optlist->{$_}{Usage};
      } else {
	$use .= $optlist->{$_}{Usage};
      }
      $use .= " (default: $optlist->{$_}{string})";
      warn "$use\n";
    }
  }
}

#----------------------------------------------------------------------

=head2 Usage - Display usage of a program

This method formats the usage for the commands and options
of a program

=cut

sub Usage {
    my ($optlist) = shift;
    my ($string,$help) = @_;

    my @com = split('', $0);
    my $com = $0;
    warn "usage: $com [commands] [options] $string\n";

    if ($optlist->{help}{Do}) {
	warn "$help\n";
    } else {$optlist->Display;}
    die "\n";
}
#----------------------------------------------------------------------

=head2 LocationRead - Location file reading method

This function reads the location file for speakerids to cdrom names.
This location file is given optionaly by the user. We provide this
function because the cdrom names looks sometimes not the way the
should in the standard conventions. As a result programs like
I<speech2sphere.perl> will not be able to find the speaker directories
on the cdroms. Now you can provide I<speech2shpere.perl> with a list
associating the speaker ID directory to a cdrom name. If this name is
specified for this ID, I<speech2sphere.perl> will search in the
corresponding cdrom. The entries in the location file should look
like: id1234 cd_name. The ID id1234 will then be searched on a
CD with the name cd_name.

=cut

sub LocationRead{
  my $optlist = shift;

  if (-f $optlist->{loc}{string}) {
    my $fh = new FileHandle;
    if ($fh->open("< $optlist->{loc}{string}")) {
      warn "reading $optlist->{loc}{string}\n";
      while (<$fh>) {
	chop;
	next if ($_ eq '');
	next if (m/^\s*\#/); #this is a comment
	s/^\s//;
	s/\s+/ /;
	my ($id,$root) = split / /, $_, 2;
	$optlist->{loc}{Root}{$id} = $root;
      }
      $fh->close;
    } else {warn "Cannot open location file: $optlist->{loc}{string}\n";}
  } else {warn "Location file $optlist->{loc}{string} not existing.\n";}
}

#----------------------------------------------------------------------

=head2 LocationWrite ($CORPUS) - Location file writing method

This function writes a location file where each entry has been
determined previously by a search program like
I<makedblists.perl>. The I<$CORPUS> variable is a string containing
the corpus name. It is written in a header at the begining of the
file.

=cut

sub LocationWrite{
  my $optlist = shift;
  my $corpus = shift;

  warn "$optlist->{loc}{string}?\n";
  if (-f $optlist->{loc}{string}) {
    die "Location file $optlist->{loc}{string} already created.\n";
  } else {
    my @lockeys = sort keys %{$optlist->{loc}{Root}};
    if ($#lockeys >= 0) {
      my $fh = new FileHandle;
      if ($fh->open("> $optlist->{loc}{string}") ) {
	warn "writing $optlist->{loc}{string}\n";
	$fh->print("# Location file for $corpus\n");
	foreach (@lockeys) {
	  $fh->print("$_ $optlist->{loc}{Root}{$_}\n");
	}
      } else {
	warn "Cannot open $optlist->{loc}{string}\n";
      }
    } else {warn "empty, not written\n";}
  }
}

#----------------------------------------------------------------------

=head2 ChannelRead - Channel file reading method

This function reads the channel file for speakerids. We provide this
function because files converted with the Zenographics Card have
sometimes swapped channels. The channel file contains a list of
speaker IDs with reference file and correponding microphone.

=cut

sub ChannelRead{
  my $optlist = shift;

  if (-f $optlist->{chan}{string}) {
    my $fh = new FileHandle;
    if ($fh->open("< $optlist->{chan}{string}")) {
      warn "reading $optlist->{chan}{string}\n";
      while (<$fh>) {
	chop;
	next if ($_ eq '');
	next if (m/^\s*\#/); #this is a comment
	s/^\s//;
	s/\s+/ /;
	my ($id,$ref) = split / /, $_, 2;
	$optlist->{chan}{Id}{$id} = $ref;
      }
      $fh->close;
    } else {warn "Cannot open channel file: $optlist->{chan}{string}\n";}
  } else {
    warn "Location file $optlist->{chan}{string} not existing.\n";
    $optlist->{chan}{Id} = undef;
  }
}

#----------------------------------------------------------------------

=head2  SpeakersRead - speakers file reading method

This function reads a speakers list in a hash with speaker references
as keys. Each entry contains also a hash with entries like name, sex,
date, etc.

=cut

sub SpeakersRead {
  my $optlist = shift;

  if (-f $optlist->{spk}{string}) {
    my $fh = new FileHandle;
    if ($fh->open("<$optlist->{spk}{string}")) {
      warn "reading $optlist->{spk}{string}\n";
      while (<$fh>) {
	chop;
	next if ($_ eq '');
	my ($ref,$name,$list,$sex,$year,$nat,$region,$date,$cd) = split /\//,$_,9;
	my $rec = {name => $name, list => $list, sex => $sex, year => $year,
		   nat => $nat, region => $region, date => $date, cd => $cd};
	$optlist->{spk}{List}{'sf'.$ref} = $rec;
      }
      $fh->close;
    } else {warn "Cannot open speakers file: $optlist->{spk}{string}\n";}
  } else {
    warn "Speakers file $optlist->{spk}{string} not existing.\n";
    $optlist->{spk}{List} = undef;
  }
}

1;



